Shareware Super Platinum 8

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / BORUSR2.ZIP;1 / BORREP.PRG < prev next >

Wrap

Text File | 1992-06-29 | 34.7 KB | 1,070 lines

*------------------------------------------------------------------------------- *-- Program.....: BORREP.PRG *-- Programmer..: Ken Mayer *-- Date........: 06/16/1992 *-- Notes.......: This program prints out a list of all the data in the *-- BOR-BBS database. *-- Note that this program takes time for each individual record, *-- due to some intensive IIF functions, as well is simple IF *-- and CASE commands. It makes the report VERY flexible, but it *-- does make it a bit slow ... have some patience ... *-- Written for.: dBASE IV, 1.1 *-- Rev. History: Minor changes here and there to cut back on wasted paper ... *-- 02/15/1992 -- Changes made to incorporate some of the *-- configuration stuff that Bowen wrote (and I aggregiously *-- borrowed and modified and ...). This should allow the user *-- to display the data on the screen, to a file, or to a *-- printer, and if a printer, to choose one of two printers. *-- 03/11/1992 -- Beginning of even more complexities ... *-- I am going to give the user the option to list the data *-- sorted by Lastname or BORBBSID. I will then allow them to *-- use a filter if they wish ... options so far include: *-- State = userinputstate *-- Those with a BBS ... *-- Those with a fax ... *-- 03/27/1992 -- Minor ... use of NETWORK() to handle exclusive *-- use of dbf if necessary, and handled getting out of the *-- printstatus() loop by pressing <Esc> key ... *-- 05/31/1992 -- (hopeful) fixes based on Beta Tester input, *-- includes <Esc> a bit smoother, and so on ... *-- 06/04/1992 -- more changes based on some stuff from Joey *-- and Keith. Should be pretty close to clean now ... *-- 06/15/1992 -- added routines to handle printing the *-- new memo field "BIO". *-- 06/29/1992 -- Added Joey's new PROGBAR procedure in place *-- of the MONITOR routine. Rather spiffy, if you ask me ... *-------------------------------------------------------------------------- *-- Please note the logic can get a bit odd, although I've tried to make this *-- as clear as possible. It may seem like mud ... >sigh<. The real problem is *-- that the routine started out simple, and I kept adding to it, which is the *-- usual problem with difficult to follow code. I have tried, consequently, *-- to add even more comments than usual to my code, in an attempt to make it *-- as easy to follow as possible ... KJM. *------------------------------------------------------------------------------- *-- setup @24,0 clear && clear out message at bottom of screen from menu *-- If network, use file in exclusive mode ... if network() use atusers excl && open data exclusive on network else use atusers && normal otherwise ... endif set escape on && allow user to press <Esc> and note it ... lEsc = .f. && did user press <Esc>? on escape lEsc = .t. && if so, turn this on ... cFile = " " && declare it here, so it's available ... *-- screen handling ... save screen to sRep cRepColor = set("ATTRIBUTE") clear ?scrnhead("&cstand2","Print BOR-BBS Data") *------------------------------------------------------------------------------- *-- Ask if they want the data sorted by last name or Borland BBS Id ... *------------------------------------------------------------------------------- *-- now find out about sorting, using Keith's routine VPick() cSortHow = VPick(8,30,"~Lastname~Borland BBS ID","Sort the List by:",; "Choose one, or <Esc> to quit",.t.,"&cStand2,&cStand,&cStand2") if lastkey() = 27 && User pressed <Esc> lEsc = .t. endif *-- Exit ... if lEsc *-- reset the environment ... restore screen from sRep release screen sRep do ReColor with cRepColor RETURN endif *-- didn't choose to exit, set the MDX tag ... if cSortHow = "L" set order to last_name else set order to borbbs_id endif *------------------------------------------------------------------------------- *-- deal with a filter ... (or not) *------------------------------------------------------------------------------- cFilter = " " && initialize this here, since we will need to have && the memvar available ... @5,0 clear *-- first ask if they want to use one at all ... if yesno(.f.,"Do you want a filter?","You can extract specific data",; "this way ...","&cl_wind1") *-- if yes, find out what filter they want ... note that a blank response *-- will avoid using a filter after all ... cType = VPick(8,30,"~State~BBS (those with)~Fax (those with)",; "Filter by:","Choose one or <Esc> for none",.t.,; "&cStand2,&cStand,&cStand2") if IsBlank(cType) && clear out message ... if lEsc && if user pressed <Esc> in this picklist, they may && want to continue anyway lEsc = .f. && so set lEsc to false. endif endif do case case cType = "S" *-- deal with getting "state" -- we're looping so that the user *-- can enter a valid state code if they got the wrong one ... *-- or if no records match ... do while .t. && loop until a valid state, or no filter ... cState = " " @12,10 say "Enter state code: " get cState picture "!!"; valid required state(cState); error chr(7)+"Enter a valid state code" read go top *-- find out if there's anything to print count to nCount for (hstate = cState .or. bstate = cState) *-- if not (nCount = 0), error message, ask if they want to *-- try again if nCount = 0 @13,10 say "** There are no records that match that code **" cYN = " " @14,10 say "Do you wish to try again? " get cYN picture "!"; valid required cYN $ "YN"; error chr(7)+"Enter 'Y' or 'N'" read if cYN = "Y" loop else set filter to exit endif && cYN ... *-- if here, we have more than one state ... else *-- deal with the fact that there are two fields that have *-- state values in 'em ... Home State (HState) and Business *-- state (BState) set filter to hstate = cState .or. bstate = cState cFilter = "hstate = cState .or. bState = cState" go top && since we moved the pointer ... exit && out of loop ... endif && nCount = 0 enddo @5,0 clear *-- Those users with BBS's case cType = "B" set filter to .not. isblank(bbsphone) cFilter = ".not. isblank(bbsphone)" *-- Those users with Fax Numbers case cType = "F" set filter to .not. isblank(fax) cFilter = ".not. isblank(fax)" endcase *-- no otherwise ... if user decides NOT to use a filter, *-- do NOTHING ... endif *------------------------------------------------------------------------------- *-- save current printer settings, so we can restore them later ... *------------------------------------------------------------------------------- cPDriver = _pDriver cPEject = _pEject nPLength = _pLength lPWait = _pWait lPQuality= _pQuality nPageLen = 65 && default page length for file/paper report lToFile = .f. lToScreen = .f. nMemoWidth = set("MEMOWIDTH") && save setting set memowidth to 70 && might as well take advantage of && the width of the page ... *------------------------------------------------------------------------------- *-- find out where the user wants to print this ... *------------------------------------------------------------------------------- if .not. lEsc on error do err_routine && routine handles pquality problems ... I hope do prntchoose && new routine below, based on && Bowen Moursund's PRNTDEMO program endif *=============================================================================== *-- PROGRAMMER NOTE: *-- If you are using this on a network, please *-- comment out or delete the following few *-- program lines, as PRINTSTATUS() does NOT *-- function on a network properly and may give *-- an error where none exists ... *=============================================================================== on error do while .not. printstatus() .and. .not. lToScreen .and. .not. lToFile ; .and. .not. lEsc do printerr enddo *------------------------------------------------------------------------------- *-- Printer message -- GET THE PRINTER READY, DUMMY! *------------------------------------------------------------------------------- if .not. lToScreen .and. .not. lToFile .and. .not. lEsc do center with 10,80,"&cStand2","Make sure the printer is ready," do center with 11,80,"&cStand2","OnLine, Turned On, has Paper." do center with 12,80,"&cstand2","Press any key when ready to start ..." x=inkey(0) @10,0 clear to 12,79 if x = 27 lEsc = .t. endif && x = 27 endif && .not. lToScreen, etc ... *------------------------------------------------------------------------------- *-- If sending output to a file, let user know where it's being sent to ... *------------------------------------------------------------------------------- if lToFile .and. .not. lEsc && to file, and user didn't press do center with 12,80,"&cStand2","Sending output to "+trim(cFile) endif *------------------------------------------------------------------------------- *-- display window on screen for user with message ... *-- Unless user is sending output to screen ... *------------------------------------------------------------------------------- if .not. lToScreen .and. .not. lEsc && not to screen and user didn't press <Esc> do center with 13,80,"&cStand2","Patience ... each record takes time" cMonColor = set("ATTRIBUTE") if isblank(cFilter) nRecords = RECCOUNT() else count to nRecords for &cFilter endif go top *-- turn off the screen, turn ON the printer (or file if using a file) ... set cursor off set console off set device to print set print on endif *------------------------------------------------------------------------------- *-- If user IS sending output to screen, then activate window, and so on ... *------------------------------------------------------------------------------- if lToScreen .and. .not. lEsc && to screen and user did not press <Esc> activate window wrep2scr endif *------------------------------------------------------------------------------- *-- And AWAAAAAAY we GO! *------------------------------------------------------------------------------- *-- set counters/other items nRecNo = 0 nPage = 0 nLine = 0 lHeading = .t. if .not. isblank(cFilter) cFilter = ".and. "+cFilter endif *------------------------------------------------------------------------------- * start processing *------------------------------------------------------------------------------- go top *-- error routine is now designed to handle printer offline, turned off, *-- and not connected ... I hope. if .not. lToScreen .and. .not. lToFile on error do err_routine endif *-- check for: End of File, use filter if it exists, and check to see *-- if user pressed the ESCape key in the PRINTSTATUS loop ... do while .not. eof() &cFilter .and. .not. lEsc *-- if not sending output to the screen, update the MONITOR window if .not. lToScreen set device to screen set console on do progbar with nRecords,"&cl_wind1","&cStand2","&cStand3",; ". . . Printing . . .",70 set device to print set console off endif *-- check how many lines we've printed if nLine => nPageLen lHeading = .t. endif *-- check to see if enough room for next record ... if .not. lHeading do LineCount && procedure below to count lines of next record ... endif *-- check for heading ... if lHeading do heading endif && lHeading *-------------------------------------------------------------------- *-- Here is where we start printing the detail lines *-------------------------------------------------------------------- ?? "Borland BBS ID: "+borbbs_id at 5 style "B" *-- print Honorific first mi last *-- i.e., Mr. Kenneth J. Mayer (or, if no honorific, Kenneth J. Mayer, *-- or, if no MI, Kenneth Mayer ...) if .not. IsBlank(honorific) ?? trim(honorific) at 32 endif ?? trim(first_name)+" "+iif(.not. IsBlank(mi),mi+". ","")+; last_name at 32+len(trim(honorific))+; iif(.not. IsBlank(honorific),1,0) ? nLine = nLine + 1 *----------------------------------------------------- *-- home address/phone first (before business/work)... *----------------------------------------------------- *-- First, look to see if there's anything to print in HOME info ... if .not. IsBlank(haddress1) .or. .not. IsBlank(hcity) .and. ; .not. IsBlank(hPhone) ?? "Home:" style "U" at 7 if .not. IsBlank(hphone) ?? hphone picture "@R (999) 999-9999" at 17 endif ? nLine = nLine + 1 endif *-- Print home address if .not. IsBlank(hAddress1) ?? trim(hAddress1) at 9 *-- add this to end of first address line ... if .not. IsBlank(haddress2) ?? ", "+haddress2 endif && .not. IsBlank(haddress2) ? nLine = nLine + 1 endif && .not. IsBlank(haddress1) *-- Print city, state, zip ... if .not. IsBlank(hcity) *-- for zip, if > 6 it's extended postal code, otherwise, *-- don't print the '-' that's in the picture code ... ?? trim(hCity)+", "+hstate+" "+; iif(len(trim(hzip))>6,hzip,left(hZip,5)) at 9 ? nLine = nLine + 1 endif && .not. IsBlank(hCity) *---------------------------------------------------------------- *-- Business info ... print ANY business info if it exists ... *---------------------------------------------------------------- if .not. IsBlank(baddress1) .or. .not. IsBlank(company) .or. ; .not. IsBlank(title) .or. .not. IsBlank(bcity) .or. ; .not. IsBlank(bPhone) ?? "Business:" style "U" at 7 if .not. IsBlank(bPhone) ?? bPhone picture "@R (999) 999-9999" at 17 endif ? nLine = nLine + 1 endif *-- see if company name exists ... if .not. IsBlank(company) ?? trim(company) at 9 if .not. IsBlank(title) ?? ", "+title endif && .not. IsBlank(title) ? nline = nline + 1 else if .not. IsBlank(title) ?? title at 9 ? nLine = nLine + 1 endif && .not. IsBlank(title) endif && .not. IsBlank(company) *-- Company/Business Address if .not. IsBlank(baddress1) ?? trim(bAddress1) at 9 if .not. IsBlank(baddress2) ?? ", "+baddress2 endif && .not. IsBlank(bAddress2) ? nLine = nLine + 1 else if .not. IsBlank(baddress2) ?? baddress2 at 9 ? nLine = nLine + 1 endif && .not. IsBlank(baddress2) endif && .not. IsBlank(bAddress1) *-- Company/Business City, state zip if .not. IsBlank(bcity) ?? trim(bcity)+", "+bstate+" "+; iif(len(trim(bzip))>6,bzip,left(bzip,5)) at 9 ? nLine = nLine + 1 endif *------------------- *-- Other info ... *------------------- do case case .not. IsBlank(fax) .and. .not. IsBlank(bbsphone) && both ?? "Fax:" style "U" at 7,; fax picture "@R (999) 999-9999" at 12,; "BBS:" style "U" at 28,; bbsphone picture "@R (999) 999-9999" at 33 ? nLine = nLine + 1 case .not. IsBlank(fax) .and. IsBlank(bbsphone) && fax only ?? "Fax:" style "U" at 7,; fax picture "@R (999) 999-9999" at 12 ? nLine = nLine + 1 case IsBlank(fax) .and. .not. IsBlank(bbsphone) && bbs only ?? "BBS:" style "U" at 7,; bbsphone picture "@R (999) 999-9999" at 12 ? nLine = nLine + 1 endcase *-- other electronic mail sources ... if .not. IsBlank(compuserve) .or. .not. IsBlank(mci_mail) .or.; .not. IsBlank(genie) .or. .not. IsBlank(fido) .or.; .not. IsBlank(internet) .or. .not. IsBlank(source) .or.; .not. IsBlank(prodigy) .or. .not. IsBlank(delphi) .or.; .not. IsBlank(am_online) ?? "EMAIL Addresses:" style "U" at 7 ? endif do case case .not. IsBlank(compuserve) .and. .not. IsBlank(mci_mail) ?? "CIS: "+compuserve at 9,; "MCI: "+mci_mail at 27 ? nLine = nLine + 1 case .not. IsBlank(compuserve) .and. IsBlank(mci_mail) ?? "CIS: "+compuserve at 9 ? nLine = nLine + 1 case IsBlank(compuserve) .and. .not. IsBlank(mci_mail) ?? "MCI: "+mci_mail at 9 ? nLine = nLine + 1 endcase do case case .not. IsBlank(genie) .and. .not. IsBlank(fido) ?? "GEnie: "+genie at 9,; "FIDO: "+fido at 42 ? nLine = nLine + 1 case .not. IsBlank(genie) .and. IsBlank(fido) ?? "GEnie: "+genie at 9 ? nLine = nLine + 1 case IsBlank(genie) .and. .not. IsBlank(fido) ?? "FIDO: "+fido at 9 ? nLine = nLine + 1 endcase if .not. IsBlank(internet) ?? "Internet: "+internet at 9 ? nLine = nLine + 1 endif if .not. IsBlank(prodigy) ?? "Prodigy: "+prodigy at 9 ? nLine = nLine + 1 endif if .not. IsBlank(Delphi) ?? "Delphi: "+delphi at 9 ? nLine = nLine + 1 endif if .not. IsBlank(am_online) ?? "America Online: " at 9 ? ?? am_online at 11 ? nLine = nLine + 2 endif if .not. IsBlank(source) ?? "Source: "+source at 9 ? nLine = nLine + 1 endif *-------------------------------------------------------------------- *-- This section deals with the MEMO field ... *-------------------------------------------------------------------- if memlines(bio) > 0 *-- Don't print on screen, but if there's something *-- here, we want the user to know it ... if lToScreen ?? "** DATA IN USER BIO FIELD **" at 7 style "B" ? nLine = nLine + 1 else *-- print field info ... ?? "User BIO: " at 7 style "B" ? nLine = nLine + 1 nMemCount = 0 && init line counter ... nMemLines = memlines(bio) && store number of lines in memo *-- if the memo is longer than the bottom of the page, *-- rather than moving the whole record to the next page, *-- we're going to deal with a special heading routine. if nLine => 57 .and. nMemLines => 5 do heading2 endif && nLines => 55 ... *-- now we're going to loop until we've printed each line of *-- the memo. do while nMemCount < nMemLines && one line at a time ... *-- check for memo printing toward bottom of page, *-- and if there's more than one line left in memo *-- to print ... if nLine => 59 .and. (nMemLines-nMemCount) => 1 && time to go to a new page? do heading2 endif *-- print the current line of the memo nMemCount = nMemCount + 1 ?? mLine(bio,nMemCount) at 7 ? nLine = nLine + 1 enddo && while nCounter ... endif && lToScreen endif && memlines(bio) > 0 *------------------------------------------------------------------- *-- End of MEMO field *-------------------------------------------------------------------- *-- blank line between records ... ? nLine = nLine + 1 skip && to next record if eof() && jest in case ... exit && we can leave the loop ... endif && eof() enddo && end of loop *------------------------------------------------------------------------------- *-- all the rest of this is cleanup ... *------------------------------------------------------------------------------- set filter to && turn off filter if there was one ... if .not. lToScreen .and. .not. lToFile .and. .not. lEsc eject && get that last sheet out of the printer ... endif if lToScreen && sent to screen, get rid of window ... if .not. lEsc do center with 17,80,"&cStand2","Press any key to continue ..." x=inkey(0) && a final pause ... endif deactivate window wRep2Scr release window wRep2Scr endif *-- return to the screen set print off if .not. lToScreen .and. window() = "WPROGBAR" && user <esc>aped out ... deactivate window wProgBar release window wProgBar release screen sProgBar release nFactor,nTimes endif *-- restore environment set console on set cursor on set device to screen set printer to set escape off on escape set memowidth to nMemoWidth *-- set printer back if .not. lToScreen .and. .not. lToFile _pDriver = cPDriver _pEject = cPEject _pLength = nPLength _pWait = lPWait on error do nothing && routine handles pquality problems ... I hope _pQuality = lPQuality && if printer driver doesn't support "quality", we should && drop to error routine below, and deal with it on error && reset processing for "ON ERROR" endif *-- clean up the screen, close down and release all that stuff restore screen from sRep release screen sRep do ReColor with cRepColor && restore colors to how they were set before && entering this program ... close database *------------------------------------------------------------------------------- *-- back to the menu *------------------------------------------------------------------------------- RETURN *------------------------------------------------------------------------------- *-- End of Main ... *------------------------------------------------------------------------------- *------------------------------------------------------------------------------- *-- This is a fairly standard heading routine ... *------------------------------------------------------------------------------- PROCEDURE Heading nPage = nPage + 1 && increment page counter if lToScreen && if to screen, don't bother with the 'heading' ... if nPage > 1 && don't do this on first screen do center with 17,80,"&cStand2","Press <Esc> to stop, "+; "or any other key to continue ..." x = inkey(0) && pause for user *-- this line added by JOEY to allow <Esc> to exit at prompt lEsc = iif(lastkey() = 27,.t.,.f.) ? && to clear out anything in buffer nLine = 0 && set line counter to 0 clear && window endif else && to printer or REPORT.TXT file if nPage > 1 && don't eject on first page -- waste of paper eject endif *-- print heading ?? "BOR-BBS Users List" at 31 style "B" ? ?? "Printed: "+dtoc(date()) at 31 ? ?? "Page: "+ltrim(str(nPage)) at 35 ? ? && blank lines ? *-- heading is printed, five lines ... nLine = 5 endif && lToScreen *-- don't come back again until we're ready (turn off heading) lHeading = .f. RETURN *-- EoP: Heading *-- This heading routine (HEADING2) is here to cope with long memos. *-- It prints the 'usual' heading, but adds a line mentioning the fact *-- that someone's BIO is being printed ... Note that since the bio is *-- not sent to the screen, the section in the heading dealing with *-- 'lToScreen' memvar has been removed from this copy of the heading. PROCEDURE Heading2 nPage = nPage + 1 && increment page counter if nPage > 1 && don't eject on first page -- waste of paper eject endif *-- print heading ?? "BOR-BBS Users List" at 31 style "B" ? ?? "Printed: "+dtoc(date()) at 31 ? ?? "Page: "+ltrim(str(nPage)) at 35 ? ? && blank lines ? *-- print note about the fact that we're printing the BIO for *-- a user ... ?? "BIO for "+trim(first_name)+" "+iif(.not. isblank(mi),mi+". ","")+; trim(last_name)+" ("+trim(borbbs_id)+")" at 5 style "B" ? ? && add a blank line here ... nLine = 7 *-- don't come back again until we're ready (turn off heading) lHeading = .f. RETURN *-- EoP: Heading2 *------------------------------------------------------------------------------- *-- This simple procedure is designed to see if there's enough room at *-- the bottom of the page for the current record. It does this by *-- checking to see what will be printed, and counting the # of lines *-- that will be printed, added to the current line number, and checking *-- against the bottom of the page ... (63). If there's not enough room, *-- we set the memvar lHeading to .t., otherwise to .f.. *-- While this routine slows down the printout, it makes for a cleaner *-- report. Records that CAN fit at the bottom of a page are printed there, *-- rather than leaving a large white space. Records that can't get moved *-- to the next page, even if it DOES mean leaving white space. There's *-- no splitting of records here ... *------------------------------------------------------------------------------- PROCEDURE LineCount nCount = nLine && grab line counter value ... nCount = nCount + 1 && count for "Borland BBS ID:" line if .not. IsBlank(haddress1) nCount = nCount + 2 && "Home Address:" and address itself ... endif if .not. IsBlank(hcity) .or. .not. IsBlank(hPhone) nCount = nCount + 1 && either way we print a line ... endif if .not. IsBlank(baddress1) .or. .not. IsBlank(company) .or. ; .not. IsBlank(title) .or. .not. IsBlank(bcity) .or. .not. IsBlank(bPhone) nCount = nCount + 1 endif if .not. IsBlank(company) .or. .not. IsBlank(title) nCount = nCount + 1 && either way we print a line endif if .not. IsBlank(baddress1) .or. .not. IsBlank(bAddress2) nCount = nCount + 1 endif if .not. IsBlank(bcity) .or. .not. IsBlank(bPhone) nCount = nCount + 1 endif if .not. IsBlank(fax) .or. .not. IsBlank(bbsphone) nCount = nCount + 1 endif if .not. IsBlank(compuserve) .or. .not. IsBlank(mci_mail) .or.; .not. IsBlank(genie) .or. .not. IsBlank(fido) .or.; .not. IsBlank(internet) .or. .not. IsBlank(source) .or.; .not. IsBlank(prodigy) .or. .not. IsBlank(delphi) .or.; .not. IsBlank(am_online) nCount = nCount + 1 && "EMAIL Addresses:" line endif if .not. IsBlank(compuserve) .or. .not. IsBlank(mci_mail) nCount = nCount + 1 endif if .not. IsBlank(genie) .or. .not. IsBlank(fido) nCount = nCount + 1 endif if .not. IsBlank(internet) nCount = nCount + 1 endif if .not. IsBlank(prodigy) nCount = nCount + 1 endif if .not. IsBlank(Delphi) nCount = nCount + 1 endif if .not. IsBlank(am_online) nCount = nCount + 2 endif if .not. IsBlank(source) nCount = nCount + 2 endif *-- if sending to screen, we're only displaying 1 line of info if there's *-- anything in the memo. if lToScreen .and. memlines(bio) > 0 nCount = nCount + 1 endif *-- otherwise we have to deal with the section in the report itself *-- SHOULD handle the memo ... if (nCount => 60 .and. .not. lToScreen) .or. ; (nCount => 15 .and. lToScreen) && absolute bottom of page/screen (-2) lHeading = .t. && we're turning on the header ... else lHeading = .f. && there's room ... endif RETURN *-- EoP: LineCount *------------------------------------------------------------------------------- *-- PRNTCHOOSE is based loosely (heavily modified) on some configuration *-- routines I got from BOWEN. The idea is to allow the user to choose from *-- the configuration they currently have, one of two printers, and setting *-- things to the screen, or a print file, are options. *------------------------------------------------------------------------------- PROCEDURE PrntChoose *-- save the screen save screen to sPrint *-- get printer memvars restore from printer.mem additive cDriver1 = trim(p_driver1) cDriver2 = trim(p_driver2) *-- Initialize a few memvars ... lToScreen = .f. lToFile = .f. _Peject = "NONE" _PageNo = 1 _PLineNo = 0 cSafety = set("SAFETY") *-- save current colors cPopColor = set("ATTRIBUTES") *-- set colors for popups set color of message to &cStand2 set color of highlight to &cStand set color of box to &cStand2 *-- define popups -- this one handles where to send output define popup pWhere from 10,33 && to 16,45 define bar 1 of pWhere prompt " Output To " skip define bar 2 of pWhere prompt replicate(chr(196),11) skip define bar 3 of pWhere prompt " Screen"; message "Send output to screen" define bar 4 of pWhere prompt " Printer "+chr(16) ; message "Send output to printer" define bar 5 of pWhere prompt " File"; message "Send output to file REPORT.TXT (or one of your choosing)" on selection popup pWhere deactivate popup *-- this popup handles quality mode ... define popup pQuality from 10,31 && to 16,50 define bar 1 of pQuality prompt " Letter or Draft " skip define bar 2 of pQuality prompt " Print Mode " skip define bar 3 of pQuality prompt replicate(chr(196),18) skip define bar 4 of pQuality prompt " Letter" ; message "Letter Quality mode" define bar 5 of pQuality prompt " Draft"; message "Draft Quality mode" on selection popup pQuality deactivate popup *-- this one handles the printer choice ... define popup pPrinter from 10,31 && to 15,48 define bar 1 of pPrinter prompt " Printer Choice " skip define bar 2 of pPrinter prompt replicate(chr(196),16) skip define bar 3 of pPrinter prompt " Printer #1" message p_name1 define bar 4 of pPrinter prompt " Printer #2" message p_name2 on selection popup pPrinter deactivate popup *-- start with the 'Where to send it' option ... do shadow with 10,33,16,45 activate popup pWhere if lastkey() = 27 && <Esc> key ... lEsc = .t. && just to make sure restore screen from sPrint endif if lEsc do ReColor with cPopColor return endif *-- determine what's next based on choice from the pWhere menu do case *-------------------------------------------------------------------- *-- Sending output to the screen ... *-------------------------------------------------------------------- case bar() = 3 && to the screen set cursor off restore screen from sPrint activate screen *-- if this driver does not exist if .not. file("ASCII.PR2") *-- GET it ... run drivers.exe -o ASCII.PR2 > nul endif _Pdriver = "ASCII.PR2" _Plength = 17 nPageLen = 15 lToScreen = .t. *-- do this in a window ... which will be activated in main routine define window wRep2Scr from 5,0 to 22,79 color &cStand NONE *-------------------------------------------------------------------- *-- Send it to the printer. This is the complex bit. Once we know *-- we're sending it to the printer, we need to handle printer *-- quality, and which printer driver/printer to send it to. *-------------------------------------------------------------------- case bar() = 4 && to the printer *-- deal with setting up the printer ... restore screen from sPrint do shadow with 10,31,16,50 *-- find out about printer quality activate popup pQuality if lastkey() = 27 restore screen from sPrint lEsc = .t. && just to make sure endif if lEsc do ReColor with cPopColor return endif restore screen from sPrint *-- printer quality ... lPQuality = (bar() = 4) do shadow with 10,31,15,48 *-- figure out which printer driver to deal with ... activate popup pPrinter if lastkey() = 27 restore screen from sPrint lEsc = .t. && just to make sure endif if lEsc do ReColor with cPopColor RETURN endif restore screen from sPrint if bar() = 3 do while .not. printstatus() .and. .not. lEsc do printerr enddo _pdriver=p_driver1 set printer to &p_port1 && printer location else do while .not. printstatus() .and. .not. lEsc do printerr enddo _pdriver=p_driver2 set printer to &p_port2 && printer location endif *-- if "quality" isn't handled here, drop to ERR_ROUTINE, *-- I hope ... _PQuality = lPQuality _pWait = .f. *-------------------------------------------------------------------- *-- Send output to a file. This routine defines the default file as being *-- called: REPORT.TXT *-------------------------------------------------------------------- case bar() = 5 && to file restore screen from sPrint *-- if file REPORT.TXT (or whatever file user wants) exists, erase it *-- we're asking for the report file ... now. cFile = "REPORT.TXT " do while .t. @15,15 say "Enter name of file: " color &cStand @15,35 get cFile picture "@!"; message "Enter name of output file, <Enter> to accept current" read @17,0 fill to 23,79 color &cStand && clear out screen ... if file("&cFile") cYN = " " @17,15 say "File already exists - erase? " color &cStand @17,44 get cYN picture "!"; valid required cYN $ "YN" error "Enter 'Y' or 'N'" read *-- if yes, erase it ... if cYN = "Y" erase (cFile) exit endif else && file doesn't exist, which is fine ... exit endif && file("&cFile") enddo && while .t. set safety off set printer to file (cFile) *-- if driver ASCII.PR2 doesn't exist, extract it if .not. file("ASCII.PR2") set console off run drivers.exe -o ASCII.PR2 > nul set console on endif _Pdriver = "ASCII.PR2" _Plength = 65 _PWait = .f. lToFile = .t. set safety &cSafety endcase *-- cleanup ... restore screen from sPrint release screen sPrint release popup pWhere release popup pPrinter release popup pQuality *-- reset colors do ReColor with cPopColor RETURN *-- EoP: PrntChoose PROCEDURE Err_Routine if error() = 331 && current printer driver does not support quality lPQuality = .f. && reset, and RETRY && reissue command ... endif *-- new errors ... 125 = Printer not ready, *-- 126 = Printer not connected or is turned off if error() = 125 .or. error() = 126 do printerr && procedure in PROC.PRG RETRY endif RETURN *-- EoP: Err_Routine PROCEDURE Nothing && here at the request of Keith ... RETURN *-- EoP: Nothing *------------------------------------------------------------------------------- * EoP: BORREP.PRG *-------------------------------------------------------------------------------